home *** CD-ROM | disk | FTP | other *** search
/ Enigma Amiga Life 109 / EnigmaAmiga109CD.iso / dalla rivista / amiga.free / sorgenti vari / wolfedit2 2.0.4 source.sit / WolfEdit2 2.0.4 Source / UAbout.p < prev    next >
Text File  |  1995-11-10  |  3KB  |  163 lines
  1. unit UAbout;
  2.  
  3. interface
  4.  
  5.     procedure IUAbout;
  6.     procedure ShowAboutBox;
  7.  
  8. implementation
  9.     uses
  10.         UGoof, UXWindow, UScreen;
  11.  
  12.     const
  13.  
  14.         aboutBoxWindID = 130;
  15.         smallAboutBoxWindID = 132;
  16.         aboutPictListID = 128;
  17.  
  18.     type
  19.  
  20.         TAboutBox = object(TXWindow)
  21.                 fAboutView: TAboutView;
  22.                 fScrollBar: ControlHandle;
  23.                 procedure IAboutBox;
  24.                 procedure Free;
  25.                 override;
  26.                 procedure CtrlOperated (theControl: ControlHandle; partCode: integer);
  27.                 override;
  28.             end;
  29.  
  30.         TAboutView = object(TView)
  31.                 fPictNum: integer;
  32.                 fPict: PicHandle;
  33.                 procedure IAboutView;
  34.                 procedure Free;
  35.                 override;
  36.                 procedure SetPict (n: integer);
  37.                 procedure Draw;
  38.                 override;
  39.             end;
  40.  
  41.         PictListHandle = ^PictListPtr;
  42.         PictListPtr = ^PictListRecord;
  43.         PictListRecord = record
  44.                 numPicts: integer;
  45.                 pictIDs: array[1..999] of integer;
  46.             end;
  47.  
  48.     var
  49.  
  50.         gAboutBox: TAboutBox;
  51.         gAboutPicts: PictListHandle;
  52.  
  53.     procedure TAboutBox.IAboutBox;
  54.         var
  55.             r: Rect;
  56.             opts: FrameOptions;
  57.             id: integer;
  58.             aboutView: TAboutView;
  59.     begin
  60.         if IsSmallScreen then
  61.             id := smallAboutBoxWindID
  62.         else
  63.             id := aboutBoxWindID;
  64.         IGetNewCWindow(nil, id, [wCloseOnGoAway]);
  65.         new(aboutView);
  66.         aboutView.IAboutView;
  67.         fAboutView := aboutView;
  68.         opts := [];
  69.         r := fBounds;
  70.         OffsetRect(r, -r.left, -r.top);
  71.         if IsSmallScreen then
  72.             Place(fAboutView, nil, nil, 0, 0, r.right, r.bottom - 24, [frmVScroll, frmBorder])
  73.         else
  74.             Place(fAboutView, nil, nil, 8, 8, natural, natural, []);
  75.         r.top := fAboutView.fFrame.fBounds.bottom;
  76.         InsetRect(r, r.right div 3, (r.bottom - r.top - 16) div 2);
  77.         fScrollBar := NewCtrl(self, r, '', true, 1, 1, gAboutPicts^^.numPicts, scrollBarProc);
  78.         Show;
  79.     end;
  80.  
  81.     procedure TAboutBox.Free;
  82.     begin
  83.         gAboutBox := nil;
  84.         inherited Free;
  85.     end;
  86.  
  87.     procedure TAboutBox.CtrlOperated (theControl: ControlHandle; partCode: integer);
  88.         var
  89.             pt: Point;
  90.             ctl: ControlHandle;
  91.     begin
  92.         if theControl = fScrollBar then begin
  93.                 case partCode of
  94.                     inUpButton, inPageUp: 
  95.                         SetCtlValue(fScrollBar, GetCtlValue(fScrollbar) - 1);
  96.                     inDownButton, inPageDown: 
  97.                         SetCtlValue(fScrollBar, GetCtlValue(fScrollbar) + 1);
  98.                     inThumb: 
  99.                         ;
  100.                     otherwise
  101.                         ;
  102.                 end;
  103.                 with fAboutView.fFrame do begin
  104.                         ctl := fScrollBars[v];
  105.                         if ctl <> nil then begin
  106.                                 FocusOnContainer;
  107.                                 SetPt(fScrollOffset, 0, 0);
  108.                                 SetCtlValue(ctl, 0);
  109.                             end;
  110.                     end;
  111.                 fAboutView.SetPict(GetCtlValue(fScrollBar));
  112.                 fAboutView.Invalidate;
  113.             end;
  114.     end;
  115.  
  116.     procedure TAboutView.IAboutView;
  117.     begin
  118.         fPict := nil;
  119.         SetPict(1);
  120.         IView(nil, nil, fPict^^.picFrame);
  121.     end;
  122.  
  123.     procedure TAboutView.Free;
  124.     begin
  125.         if fPict <> nil then
  126.             ReleaseResource(Handle(fPict));
  127.         inherited Free;
  128.     end;
  129.  
  130.     procedure TAboutView.SetPict (n: integer);
  131.     begin
  132.         if fPict <> nil then
  133.             ReleaseResource(Handle(fPict));
  134.         fPict := nil;
  135.         fPictNum := n;
  136.         with gAboutPicts^^ do
  137.             if (n >= 1) & (n <= numPicts) then
  138.                 fPict := PicHandle(GetResource('PICT', pictIDs[n]));
  139.     end;
  140.  
  141.     procedure TAboutView.Draw;
  142.     begin
  143.         EraseRect(fExtent);
  144.         if fPict <> nil then
  145.             DrawPicture(fPict, fPict^^.picFrame);
  146.     end;
  147.  
  148.     procedure IUAbout;
  149.     begin
  150.         gAboutBox := nil;
  151.         gAboutPicts := PictListHandle(GetResource('PIC#', aboutPictListID));
  152.     end;
  153.  
  154.     procedure ShowAboutBox;
  155.     begin
  156.         if gAboutBox = nil then begin
  157.                 new(gAboutBox);
  158.                 gAboutBox.IAboutBox;
  159.             end;
  160.         gAboutBox.Select;
  161.     end;
  162.  
  163. end.